perm filename SETQUE.NEW[1,JRA]2 blob sn#012424 filedate 1972-11-13 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP TRY1 
00400	 (LAMBDA(L)
00500	  (PROG (FILENAM PRNO POTZTBL NEWNAME TBL TIME1 Z Z2 AXNO)
00600		(SETQ PRNO 0)
00700	   T2   (COND ((NULL L) (SETQ FILENAM (QUOTE (P R F))) (GO P3)))
00800		(SETQ Z (CAR (LAST L)))
00900		(SETQ FILENAM (EXPLODE (COND ((ATOM Z) Z) (T (CAR Z)))))
01000		(EVAL (CONS (QUOTE INPUT) L))
01100		(INC T)
01200	   P3 B (SETQ Z2 (INCLAUSES))
01300		(INC NIL)
01400		(COND ((NULL Z2) (RETURN NIL)))
01500		(SETQ TIME1 (DIFFERENCE (TIME) (GCTIME)))
01600		(SETQ Z2 (ATTEMPT Z2 NIL NIL))
01700	   A    (COND ((OR (NULL Z2) (EQ (CAR Z2) (QUOTE QED))) (RETURN (QUOTE *)))
01800		      ((EQ (CAR Z2) (QUOTE NOPROOF)) (SETQ Z2 (ATTEMPT (INITIALAX1 (CADR Z2)) (CDDR Z2) NIL)))
01900		      ((EQ (CAR Z2) (QUOTE ABORT))
02000		       (SETQ Z2 (ATTEMPT (INITIALAX1 (APPEND (CADR Z2) (CDDR Z2))) NIL NIL))))
02100		(GO A))) 
02200	FEXPR)
     

00100	(SETQ STFLG NIL)
00200	
00300	(DE >IVAR<(%N)(OUTRUL %N(FUNCTION(LAMBDA()(COND((NUMBERP(STK1))(COND
00400	  (STFLG(STK1))(T(CDR(ASSOC(STK1)OUTVAR)))))
00500	((EQ(STK1)(QUOTE LENGTH))LENGTH)
00600	((EQ(STK1)(QUOTE DEPTH))DEPTH))))) )
00700	
00800	
00900	
01000	(DEFPROP OUTIT 
01100	 (LAMBDA (XYZ) (PROG (STFLG) (SETQ STFLG T) (OUT >ST< XYZ))) 
01200	EXPR)
01300	
01400	(DEFPROP QUERY 
01500	 (LAMBDA NIL
01600	  (PROG NIL
01700		(COND (STRATEGY (PRINT (QUOTE CHOICE-STRATEGY-IS:)) (OUTIT (CAR (LAST STRATEGY)))))
01800		(PRINT (QUOTE EDIT-STRATEGY-IS:))
01900		(OUTIT (CAR (LAST EDITSTRAT)))
02000		(COND ((AND (NULL PMODEL) (NULL NMODEL)) (GRINDEF MODEL))
02100		      (T (PRINT (QUOTE POSITIVE-MODEL=))
02200			 (PRINC PMODEL)
02300			 (PRINT (QUOTE NEGATIVE-MODEL=))
02400			 (PRINC NMODEL)))
02500		(PRINT (QUOTE PARMODULATE))
02600		(PRINC (QUOTE =))
02700		(COND ((NOT PFLG) (PRINC T)
02800				  (PRINT (QUOTE EQUAL-SYMBOL))
02900				  (PRINC (QUOTE =))
03000				  (PRINC EQUAL)
03100				  (PRINT (QUOTE PAR-DEPTH-BOUND))
03200				  (PRINC (QUOTE =))
03300				  (PRINC PDEPTH))
03400		      (T (PRINC NIL)))
03500		(PRINT (QUOTE ELAPSED-TIME))
03600		(PRINC (QUOTE =))
03700		(PRINC (TIMEIT))
03800		(RETURN (TERPRI)))) 
03900	EXPR)
04000	
04100	(DEFPROP SETQUERY2 
04200	 (LAMBDA(XX YY FLG)
04300	  (PROG (XYZ1 N
04400	 	      CHAN
04500	 	      Z
04600	 	      Z1
04700	 	      Z3
04800	 	      XYZ
04900	 	      Z6
05000	 	      SUPPORT
05100	 	      EDITSTRAT
05200	 	      MERGE
05300	 	      ORDER
05400	 	      DEBUG
05500	 	      DEPTH
05600	 	      LENGTH
05700	 	      ANCESTRY
05800	 	      STRATEGY
05900	 	      PMODEL
06000	 	      NMODEL
06100	 	      PFLG
06200	 	      PDEPTH
06300	 	      DLIST)
06400		(SETQ CHAN (OUTC NIL NIL))
06500		(COND (FLG (UPDATESTATE YY)))
06600		(SETQ XYZ1 XX)
06700		(COND ((NULL FLG) (GO SRA1)) ((NULL (CAR XX)) (SETQ XYZ1 (CDR XYZ1)) (GO SRA)))
06800		(PRINT SETQMESS)
06900		(SETQ XX (UPDATE XX))
07000		(SETQ XYZ1 XX)
07100	   SRA1 (COND ((NULL (CAR XX)) (SETQ XYZ1 (CDR XYZ1)) (GO SRA)))
07200		(PRINT (QUOTE HERE-ARE-THE-CLAUSES:))
07300		(SETQ N 1)
07400	AA(CLAUSES XX)
07500	   SRA  (COND ((AND AUTO (NULL FLG)) (SETQ Z (AUTO XYZ1)) (OUTC CHAN NIL) (RETURN Z))
07600		      (AUTO (PRINT (QUOTE (STILL-AUTO (Y / N))))
07700			    (COND
07800			     ((EQ (READ) (QUOTE Y)) (SETQ Z (CONS XYZ1 (AUTO XYZ1))) (OUTC CHAN NIL) (RETURN Z)))))
07900	SR2A
08000		 (PRINT (QUOTE CHOICE-STRATEGY-IS:))
08100	(COND(FLG	      (COND (ANCESTRY (PRINT (QUOTE ANCESTRY)))
08200			    (STRATEGY (OUTIT (CAR (LAST STRATEGY))))
08300			    (T (PRINT NIL)))
08400		      (PRINT (QUOTE DO-YOU-WANT-TO-CHANGE-IT))
08500		      (SETQ Z (READ))
08600		      (COND ((EQ Z (QUOTE N)) (GO SRB)))))
08700		(SCANSET)
08800		(START)
08900		(SETQ Z (ERRSET (<ST>) T))
09000		(SCANRESET)
09100		(COND ((OR (NULL Z) (NULL (CAR Z))) (PRINT (QUOTE SCREWED-STRATEGY)) (GO SRA2)))
09200		(SETQ ZIN (TOP))
09300		(SETQ STRATEGY (LIST (QUOTE LAMBDA) (QUOTE (C1 C2)) ZIN))
09400		(OUTIT ZIN)
09500	   SRB  (PRINT (QUOTE DEBUG=))
09600		(COND (FLG (RESTRAT DEBUG SRA SRAA) (PRINC DEBUG) (BARF NIL) (RESTRAT2 DEBUG SRA))
09700		      (T (RESTRATS DEBUG SRA)))
09800	   SRAA SRC
09900	SRD
10000		 (PRINT (QUOTE EDIT-STRATEGY-IS:))
10100	(COND(FLG	      (OUTIT (CAR (LAST EDITSTRAT)))
10200		      (PRINT (QUOTE DO-YOU-WANT-TO-CHANGE-IT))
10300		      (SETQ Z (READ))
10400		      (COND ((EQ Z (QUOTE N)) (GO SRCA)))))
10500		(SCANSET)
10600		(START)
10700		(SETQ Z1 (ERRSET (<ST>) T))
10800		(SCANRESET)
10900		(COND ((OR (NULL Z1) (NULL (CAR Z1))) (PRINT (QUOTE SCREWED-EDIT-STRATEGY)) (GO SRAA)))
11000		(SETQ ZIN (TOP))
11100		(SETQ EDITSTRAT (LIST (QUOTE LAMBDA) (QUOTE (C)) ZIN))
11200		(OUTIT ZIN)
11300	   SRCA SRI
11400		(PRINT (QUOTE (UNIT-REDUCTION (Y / N))))
11500		(COND (FLG (RESTRAT UFLG SRD SRIA) (PRINC UFLG) (BARF NIL) (RESTRAT2 UFLG SRC))
11600		      (T (RESTRATS UFLG SRD)))
11700	   SRIA SRE
11800	(PRINT @EQUALITY-REPLACEMENT-IS:)
11900		(COND (FLG 
12000			   (PRINC (QUOTE / ))
12100			   (COND (PFLG (PRINC (QUOTE OFF))) (T (PRINC (QUOTE ON))))
12200			   (PRINT (QUOTE (DO YOU WANT TO CHANGE IT (Y / N))))
12300			   (SETQ Z3 (READ))
12400			   (COND ((EQ Z3 (QUOTE Y)) (GO SRDA))
12500				 ((EQ Z3 (QUOTE N)) (GO SPQ6))
12600				 ((EQ Z3 ESCAPE) (PRINT (QUOTE RESETTING-TO:)) (GO SRI))
12700				 (T (GO SRE))))
12800		      (T (PRINC (QUOTE (Y / N)))
12900			 (RESTRATS Z3 SRI)
13000			 (SETQ EQUAL ESCAPE)
13100			 (COND ((EQ Z3 (QUOTE N)) (GO SPQ5)))))
13200	   SRDA (SETQ AXNO 1)
13300	   SRF  (PRINT (QUOTE EQUAL-SYMBOL=))
13400		(COND (FLG (RESTRAT EQUAL SRE SREA) (PRINC EQUAL) (BARF NIL) (RESTRAT2 EQUAL SRE))
13500		      (T (RESTRATS EQUAL SRE)))
13600	   SREA(COND((NULL EQUAL)(GO SPQ5))) (SETQ PFLG NIL)
13700	   SRG  (PRINT (QUOTE PAR-DEPTH-BOUND=))
13800		(COND (FLG (RESTRAT PDEPTH SRF SRFA) (PRINC PDEPTH) (BARF NIL) (RESTRAT2 PDEPTH SRF))
13900		      (T (RESTRATS PDEPTH SRF)))
14000	   SRFA P1
14100		(PRINT (QUOTE DEMODULATION-LIST=))
14200	(COND(FLG(COND(DLIST(CLAUSES DLIST))(T(PRINT NIL)))
14300	(PRINT @DO-YOU-WANT-TO-CHANGE-IT)
14400	(SETQ Z(READ))(COND((EQ Z @Y)(GO SRHB))((EQ Z @N)(GO SRH))
14500	((EQ Z ESCAPE)(GO SRG))(T(GO SRFA)))))
14600	SRHB	(PRINT (QUOTE (TYPE: 'NONE' OR 'IN' (TO INSERT))))
14700	(SETQ Z (READ))
14800		(COND ((EQ Z (QUOTE NONE)) (SETQ DLIST NIL)(GO SPQ6))
14900		      ((EQ Z (QUOTE IN)) (GO P2))
15000		      (T (PRINT (QUOTE UNDEFINED-SPECIFICATION-FOR-DEMOD-LIST))))
15100		(GO P1)
15200	P2(SETQ Z3(UPGETL XYZ1(LIST (CONS @CLAUSES XYZ1))))
15300	   P2A  (COND ((NULL Z3) (PRINT (QUOTE ERROR-TRY-AGAIN)) (GO P1)))
15400	   P3   (SET3 (SETQ DLIST (NCONC DLIST Z3)))
15500	   SRH  (PRINT (QUOTE DEMOD-DEPTH-BOUND=))
15600		(COND (FLG (RESTRAT DDEPTH P1 SRGA) (PRINC DDEPTH) (BARF NIL) (RESTRAT2 DDEPTH P1))
15700		      (T (RESTRATS DDEPTH P1)))
15800	   SRGA P6
15900		(GO SPQ6)
16000	   SPQ5 (SETQ PFLG T)
16100	   SPQ6 (SETQ Z1
16200		      (LIST STRATEGY
16300	 		    SUPPORT
16400	 		    EDITSTRAT
16500	 		    MERGE
16600	 		    ORDER
16700	 		    DEBUG
16800	 		    DEPTH
16900	 		    LENGTH
17000	 		    ANCESTRY
17100	 		    PMODEL
17200	 		    NMODEL
17300	 		    PFLG
17400	 		    EQUAL
17500	 		    PDEPTH
17600	 		    DLIST))
17700		(OUTC CHAN NIL)
17800		(COND (FLG (RETURN (CONS XYZ1 Z1))) (T (RETURN Z1))))) 
17900	EXPR)